home *** CD-ROM | disk | FTP | other *** search
- ;;; skeleton.el --- Lisp language extension for writing statement skeletons
-
- ;; Copyright (C) 1993, 1994, 1995, 1996 by Free Software Foundation, Inc.
-
- ;; Author: Daniel.Pfeiffer@Informatik.START.dbp.de, fax (+49 69) 7588-2389
- ;; Maintainer: FSF
- ;; Keywords: extensions, abbrev, languages, tools
-
- ;; This file is part of GNU Emacs.
-
- ;; GNU Emacs is free software; you can redistribute it and/or modify
- ;; it under the terms of the GNU General Public License as published by
- ;; the Free Software Foundation; either version 2, or (at your option)
- ;; any later version.
-
- ;; GNU Emacs is distributed in the hope that it will be useful,
- ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
- ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- ;; GNU General Public License for more details.
-
- ;; You should have received a copy of the GNU General Public License
- ;; along with GNU Emacs; see the file COPYING. If not, write to the
- ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
- ;; Boston, MA 02111-1307, USA.
-
- ;;; Commentary:
-
- ;; A very concise language extension for writing structured statement
- ;; skeleton insertion commands for programming language modes. This
- ;; originated in shell-script mode and was applied to ada-mode's
- ;; commands which shrunk to one third. And these commands are now
- ;; user configurable.
-
- ;;; Code:
-
- ;; page 1: statement skeleton language definition & interpreter
- ;; page 2: paired insertion
- ;; page 3: mirror-mode, an example for setting up paired insertion
-
-
- (defvar skeleton-transformation nil
- "*If non-nil, function applied to literal strings before they are inserted.
- It should take strings and characters and return them transformed, or nil
- which means no transformation.
- Typical examples might be `upcase' or `capitalize'.")
-
- ; this should be a fourth argument to defvar
- (put 'skeleton-transformation 'variable-interactive
- "aTransformation function: ")
-
-
- (defvar skeleton-autowrap t
- "Controls wrapping behaviour of functions created with `define-skeleton'.
- When the region is visible (due to `transient-mark-mode' or marking a region
- with the mouse) and this is non-`nil' and the function was called without an
- explicit ARG, then the ARG defaults to -1, i.e. wrapping around the visible
- region.
-
- We will probably delete this variable in a future Emacs version
- unless we get a substantial number of complaints about the auto-wrap
- feature.")
-
- (defvar skeleton-end-hook
- (lambda ()
- (or (eolp) (newline-and-indent)))
- "Hook called at end of skeleton but before going to point of interest.
- By default this moves out anything following to next line.
- The variables `v1' and `v2' are still set when calling this.")
-
-
- ;;;###autoload
- (defvar skeleton-filter 'identity
- "Function for transforming a skeleton proxy's aliases' variable value.")
-
- (defvar skeleton-untabify t
- "When non-`nil' untabifies when deleting backwards with element -ARG.")
-
- (defvar skeleton-newline-indent-rigidly nil
- "When non-`nil', indent rigidly under current line for element `\\n'.
- Else use mode's `indent-line-function'.")
-
- (defvar skeleton-further-elements ()
- "A buffer-local varlist (see `let') of mode specific skeleton elements.
- These variables are bound while interpreting a skeleton. Their value may
- in turn be any valid skeleton element if they are themselves to be used as
- skeleton elements.")
- (make-variable-buffer-local 'skeleton-further-elements)
-
-
- (defvar skeleton-subprompt
- (substitute-command-keys
- "RET, \\<minibuffer-local-map>\\[abort-recursive-edit] or \\[help-command]")
- "*Replacement for %s in prompts of recursive subskeletons.")
-
-
- (defvar skeleton-abbrev-cleanup nil
- "Variable used to delete the character that led to abbrev expansion.")
-
-
- (defvar skeleton-debug nil
- "*If non-nil `define-skeleton' will override previous definition.")
-
- ;; reduce the number of compiler warnings
- (defvar skeleton)
- (defvar skeleton-modified)
- (defvar skeleton-point)
- (defvar skeleton-regions)
-
- ;;;###autoload
- (defmacro define-skeleton (command documentation &rest skeleton)
- "Define a user-configurable COMMAND that enters a statement skeleton.
- DOCUMENTATION is that of the command, while the variable of the same name,
- which contains the skeleton, has a documentation to that effect.
- INTERACTOR and ELEMENT ... are as defined under `skeleton-insert'."
- (if skeleton-debug
- (set command skeleton))
- `(progn
- (defun ,command (&optional str arg)
- ,(concat documentation
- (if (string-match "\n\\>" documentation)
- "" "\n")
- "\n"
- "This is a skeleton command (see `skeleton-insert').
- Normally the skeleton text is inserted at point, with nothing \"inside\".
- If there is a highlighted region, the skeleton text is wrapped
- around the region text.
-
- A prefix argument ARG says to wrap the skeleton around the next ARG words.
- A prefix argument of zero says to wrap around zero words---that is, nothing.
- This is a way of overiding the use of a highlighted region.")
- (interactive "*P\nP")
- (skeleton-proxy-new ',skeleton str arg))))
-
- ;;;###autoload
- (defun skeleton-proxy-new (skeleton &optional str arg)
- "Insert skeleton defined by variable of same name (see `skeleton-insert').
- Prefix ARG allows wrapping around words or regions (see `skeleton-insert').
- If no ARG was given, but the region is visible, ARG defaults to -1 depending
- on `skeleton-autowrap'. An ARG of M-0 will prevent this just for once.
- This command can also be an abbrev expansion (3rd and 4th columns in
- \\[edit-abbrevs] buffer: \"\" command-name).
-
- When called as a function, optional first argument STR may also be a string
- which will be the value of `str' whereas the skeleton's interactor is then
- ignored."
- (interactive "*P\nP")
- (setq skeleton (funcall skeleton-filter skeleton))
- (if (not skeleton)
- (if (memq this-command '(self-insert-command
- skeleton-pair-insert-maybe
- expand-abbrev))
- (setq buffer-undo-list (primitive-undo 1 buffer-undo-list)))
- (skeleton-insert skeleton
- (if (setq skeleton-abbrev-cleanup
- (or (eq this-command 'self-insert-command)
- (eq this-command
- 'skeleton-pair-insert-maybe)))
- ()
- ;; Pretend C-x a e passed its prefix arg to us
- (if (or arg current-prefix-arg)
- (prefix-numeric-value (or arg
- current-prefix-arg))
- (and skeleton-autowrap
- (or (eq last-command 'mouse-drag-region)
- (and transient-mark-mode mark-active))
- -1)))
- (if (stringp str)
- str))
- (and skeleton-abbrev-cleanup
- (setq skeleton-abbrev-cleanup (point))
- (add-hook 'post-command-hook 'skeleton-abbrev-cleanup nil t))))
-
- ;; This command isn't meant to be called, only it's aliases with meaningful
- ;; names are.
- ;;;###autoload
- (defun skeleton-proxy (&optional str arg)
- "Insert skeleton defined by variable of same name (see `skeleton-insert').
- Prefix ARG allows wrapping around words or regions (see `skeleton-insert').
- If no ARG was given, but the region is visible, ARG defaults to -1 depending
- on `skeleton-autowrap'. An ARG of M-0 will prevent this just for once.
- This command can also be an abbrev expansion (3rd and 4th columns in
- \\[edit-abbrevs] buffer: \"\" command-name).
-
- When called as a function, optional first argument STR may also be a string
- which will be the value of `str' whereas the skeleton's interactor is then
- ignored."
- (interactive "*P\nP")
- (let ((function (nth 1 (backtrace-frame 1))))
- (if (eq function 'nth) ; uncompiled Lisp function
- (setq function (nth 1 (backtrace-frame 5)))
- (if (eq function 'byte-code) ; tracing byte-compiled function
- (setq function (nth 1 (backtrace-frame 2)))))
- (if (not (setq function (funcall skeleton-filter (symbol-value function))))
- (if (memq this-command '(self-insert-command
- skeleton-pair-insert-maybe
- expand-abbrev))
- (setq buffer-undo-list (primitive-undo 1 buffer-undo-list)))
- (skeleton-insert function
- (if (setq skeleton-abbrev-cleanup
- (or (eq this-command 'self-insert-command)
- (eq this-command
- 'skeleton-pair-insert-maybe)))
- ()
- ;; Pretend C-x a e passed its prefix arg to us
- (if (or arg current-prefix-arg)
- (prefix-numeric-value (or arg
- current-prefix-arg))
- (and skeleton-autowrap
- (or (eq last-command 'mouse-drag-region)
- (and transient-mark-mode mark-active))
- -1)))
- (if (stringp str)
- str))
- (and skeleton-abbrev-cleanup
- (setq skeleton-abbrev-cleanup (point))
- (add-hook 'post-command-hook 'skeleton-abbrev-cleanup nil t)))))
-
-
- (defun skeleton-abbrev-cleanup (&rest list)
- "Value for `post-command-hook' to remove char that expanded abbrev."
- (if (integerp skeleton-abbrev-cleanup)
- (progn
- (delete-region skeleton-abbrev-cleanup (point))
- (setq skeleton-abbrev-cleanup)
- (remove-hook 'post-command-hook 'skeleton-abbrev-cleanup t))))
-
-
- ;;;###autoload
- (defun skeleton-insert (skeleton &optional skeleton-regions str)
- "Insert the complex statement skeleton SKELETON describes very concisely.
-
- With optional third REGIONS wrap first interesting point (`_') in skeleton
- around next REGIONS words, if REGIONS is positive. If REGIONS is negative,
- wrap REGIONS preceding interregions into first REGIONS interesting positions
- \(successive `_'s) in skeleton. An interregion is the stretch of text between
- two contiguous marked points. If you marked A B C [] (where [] is the cursor)
- in alphabetical order, the 3 interregions are simply the last 3 regions. But
- if you marked B A [] C, the interregions are B-A, A-[], []-C.
-
- Optional fourth STR is the value for the variable `str' within the skeleton.
- When this is non-`nil' the interactor gets ignored, and this should be a valid
- skeleton element.
-
- SKELETON is made up as (INTERACTOR ELEMENT ...). INTERACTOR may be nil if
- not needed, a prompt-string or an expression for complex read functions.
-
- If ELEMENT is a string or a character it gets inserted (see also
- `skeleton-transformation'). Other possibilities are:
-
- \\n go to next line and indent according to mode
- _ interesting point, interregion here, point after termination
- > indent line (or interregion if > _) according to major mode
- & do next ELEMENT if previous moved point
- | do next ELEMENT if previous didn't move point
- -num delete num preceding characters (see `skeleton-untabify')
- resume: skipped, continue here if quit is signaled
- nil skipped
-
- Further elements can be defined via `skeleton-further-elements'. ELEMENT may
- itself be a SKELETON with an INTERACTOR. The user is prompted repeatedly for
- different inputs. The SKELETON is processed as often as the user enters a
- non-empty string. \\[keyboard-quit] terminates skeleton insertion, but
- continues after `resume:' and positions at `_' if any. If INTERACTOR in such
- a subskeleton is a prompt-string which contains a \".. %s ..\" it is
- formatted with `skeleton-subprompt'. Such an INTERACTOR may also a list of
- strings with the subskeleton being repeated once for each string.
-
- Quoted Lisp expressions are evaluated evaluated for their side-effect.
- Other Lisp expressions are evaluated and the value treated as above.
- Note that expressions may not return `t' since this implies an
- endless loop. Modes can define other symbols by locally setting them
- to any valid skeleton element. The following local variables are
- available:
-
- str first time: read a string according to INTERACTOR
- then: insert previously read string once more
- help help-form during interaction with the user or `nil'
- input initial input (string or cons with index) while reading str
- v1, v2 local variables for memorizing anything you want
-
- When done with skeleton, but before going back to `_'-point call
- `skeleton-end-hook' if that is non-`nil'."
- (and skeleton-regions
- (setq skeleton-regions
- (if (> skeleton-regions 0)
- (list (point-marker)
- (save-excursion (forward-word skeleton-regions)
- (point-marker)))
- (setq skeleton-regions (- skeleton-regions))
- ;; copy skeleton-regions - 1 elements from `mark-ring'
- (let ((l1 (cons (mark-marker) mark-ring))
- (l2 (list (point-marker))))
- (while (and l1 (> skeleton-regions 0))
- (setq l2 (cons (car l1) l2)
- skeleton-regions (1- skeleton-regions)
- l1 (cdr l1)))
- (sort l2 '<))))
- (goto-char (car skeleton-regions))
- (setq skeleton-regions (cdr skeleton-regions)))
- (let ((beg (point))
- skeleton-modified skeleton-point resume: help input v1 v2)
- (unwind-protect
- (eval `(let ,skeleton-further-elements
- (skeleton-internal-list skeleton str)))
- (run-hooks 'skeleton-end-hook)
- (sit-for 0)
- (or (pos-visible-in-window-p beg)
- (progn
- (goto-char beg)
- (recenter 0)))
- (if skeleton-point
- (goto-char skeleton-point)))))
-
- (defun skeleton-read (str &optional initial-input recursive)
- "Function for reading a string from the minibuffer within skeletons.
- PROMPT may contain a `%s' which will be replaced by `skeleton-subprompt'.
- If non-`nil' second arg INITIAL-INPUT or variable `input' is a string or
- cons with index to insert before reading. If third arg RECURSIVE is non-`nil'
- i.e. we are handling the iterator of a subskeleton, returns empty string if
- user didn't modify input.
- While reading, the value of `minibuffer-help-form' is variable `help' if that
- is non-`nil' or a default string."
- (let ((minibuffer-help-form (or (if (boundp 'help) (symbol-value 'help))
- (if recursive "\
- As long as you provide input you will insert another subskeleton.
-
- If you enter the empty string, the loop inserting subskeletons is
- left, and the current one is removed as far as it has been entered.
-
- If you quit, the current subskeleton is removed as far as it has been
- entered. No more of the skeleton will be inserted, except maybe for a
- syntactically necessary termination."
- "\
- You are inserting a skeleton. Standard text gets inserted into the buffer
- automatically, and you are prompted to fill in the variable parts.")))
- (eolp (eolp)))
- ;; since Emacs doesn't show main window's cursor, do something noticeable
- (or eolp
- (open-line 1))
- (unwind-protect
- (setq str (if (stringp str)
- (read-string (format str skeleton-subprompt)
- (setq initial-input
- (or initial-input
- (symbol-value 'input))))
- (eval str)))
- (or eolp
- (delete-char 1))))
- (if (and recursive
- (or (null str)
- (string= str "")
- (equal str initial-input)
- (equal str (car-safe initial-input))))
- (signal 'quit t)
- str))
-
- (defun skeleton-internal-list (skeleton &optional str recursive)
- (let* ((start (save-excursion (beginning-of-line) (point)))
- (column (current-column))
- (line (buffer-substring start
- (save-excursion (end-of-line) (point))))
- opoint)
- (or str
- (setq str `(setq str (skeleton-read ',(car skeleton) nil ,recursive))))
- (while (setq skeleton-modified (eq opoint (point))
- opoint (point)
- skeleton (cdr skeleton))
- (condition-case quit
- (skeleton-internal-1 (car skeleton))
- (quit
- (if (eq (cdr quit) 'recursive)
- (setq recursive 'quit
- skeleton (memq 'resume: skeleton))
- ;; remove the subskeleton as far as it has been shown
- ;; the subskeleton shouldn't have deleted outside current line
- (end-of-line)
- (delete-region start (point))
- (insert line)
- (move-to-column column)
- (if (cdr quit)
- (setq skeleton ()
- recursive nil)
- (signal 'quit 'recursive)))))))
- ;; maybe continue loop or go on to next outer resume: section
- (if (eq recursive 'quit)
- (signal 'quit 'recursive)
- recursive))
-
-
- (defun skeleton-internal-1 (element &optional literal)
- (cond ((char-or-string-p element)
- (if (and (integerp element) ; -num
- (< element 0))
- (if skeleton-untabify
- (backward-delete-char-untabify (- element))
- (delete-backward-char (- element)))
- (insert-before-markers (if (and skeleton-transformation
- (not literal))
- (funcall skeleton-transformation element)
- element))))
- ((eq element '\n) ; actually (eq '\n 'n)
- (if (and skeleton-regions
- (eq (nth 1 skeleton) '_))
- (progn
- (or (eolp)
- (newline))
- (indent-region (point) (car skeleton-regions) nil))
- (if skeleton-newline-indent-rigidly
- (indent-to (prog1 (current-indentation)
- (newline)))
- (newline)
- (indent-according-to-mode))))
- ((eq element '>)
- (if (and skeleton-regions
- (eq (nth 1 skeleton) '_))
- (indent-region (point) (car skeleton-regions) nil)
- (indent-according-to-mode)))
- ((eq element '_)
- (if skeleton-regions
- (progn
- (goto-char (car skeleton-regions))
- (setq skeleton-regions (cdr skeleton-regions))
- (and (<= (current-column) (current-indentation))
- (eq (nth 1 skeleton) '\n)
- (end-of-line 0)))
- (or skeleton-point
- (setq skeleton-point (point)))))
- ((eq element '&)
- (if skeleton-modified
- (setq skeleton (cdr skeleton))))
- ((eq element '|)
- (or skeleton-modified
- (setq skeleton (cdr skeleton))))
- ((eq 'quote (car-safe element))
- (eval (nth 1 element)))
- ((or (stringp (car-safe element))
- (consp (car-safe element)))
- (if (symbolp (car-safe (car element)))
- (while (skeleton-internal-list element nil t))
- (setq literal (car element))
- (while literal
- (skeleton-internal-list element (car literal))
- (setq literal (cdr literal)))))
- ((null element))
- ((skeleton-internal-1 (eval element) t))))
-
-
- ;; Maybe belongs into simple.el or elsewhere
- ;; ;###autoload
- ;;; (define-skeleton local-variables-section
- ;; "Insert a local variables section. Use current comment syntax if any."
- ;; (completing-read "Mode: " obarray
- ;; (lambda (symbol)
- ;; (if (commandp symbol)
- ;; (string-match "-mode$" (symbol-name symbol))))
- ;; t)
- ;; '(save-excursion
- ;; (if (re-search-forward page-delimiter nil t)
- ;; (error "Not on last page.")))
- ;; comment-start "Local Variables:" comment-end \n
- ;; comment-start "mode: " str
- ;; & -5 | '(kill-line 0) & -1 | comment-end \n
- ;; ( (completing-read (format "Variable, %s: " skeleton-subprompt)
- ;; obarray
- ;; (lambda (symbol)
- ;; (or (eq symbol 'eval)
- ;; (user-variable-p symbol)))
- ;; t)
- ;; comment-start str ": "
- ;; (read-from-minibuffer "Expression: " nil read-expression-map nil
- ;; 'read-expression-history) | _
- ;; comment-end \n)
- ;; resume:
- ;; comment-start "End:" comment-end \n)
-
- ;; Variables and command for automatically inserting pairs like () or "".
-
- (defvar skeleton-pair nil
- "*If this is nil pairing is turned off, no matter what else is set.
- Otherwise modes with `skeleton-pair-insert-maybe' on some keys
- will attempt to insert pairs of matching characters.")
-
-
- (defvar skeleton-pair-on-word nil
- "*If this is nil, paired insertion is inhibited before or inside a word.")
-
-
- (defvar skeleton-pair-filter (lambda ())
- "Attempt paired insertion if this function returns nil, before inserting.
- This allows for context-sensitive checking whether pairing is appropriate.")
-
-
- (defvar skeleton-pair-alist ()
- "An override alist of pairing partners matched against `last-command-char'.
- Each alist element, which looks like (ELEMENT ...), is passed to
- `skeleton-insert' with no interactor. Variable `str' does nothing.
-
- Elements might be (?` ?` _ \"''\"), (?\\( ? _ \" )\") or (?{ \\n > _ \\n ?} >).")
-
-
- ;;;###autoload
- (defun skeleton-pair-insert-maybe (arg)
- "Insert the character you type ARG times.
-
- With no ARG, if `skeleton-pair' is non-nil, pairing can occur. If the region
- is visible the pair is wrapped around it depending on `skeleton-autowrap'.
- Else, if `skeleton-pair-on-word' is non-nil or we are not before or inside a
- word, and if `skeleton-pair-filter' returns nil, pairing is performed.
-
- If a match is found in `skeleton-pair-alist', that is inserted, else
- the defaults are used. These are (), [], {}, <> and `' for the
- symmetrical ones, and the same character twice for the others."
- (interactive "*P")
- (let ((mark (and skeleton-autowrap
- (or (eq last-command 'mouse-drag-region)
- (and transient-mark-mode mark-active))))
- (skeleton-end-hook))
- (if (or arg
- (not skeleton-pair)
- (and (not mark)
- (or overwrite-mode
- (if (not skeleton-pair-on-word) (looking-at "\\w"))
- (funcall skeleton-pair-filter))))
- (self-insert-command (prefix-numeric-value arg))
- (setq last-command-char (logand last-command-char 255))
- (or skeleton-abbrev-cleanup
- (skeleton-insert
- (cons nil (or (assq last-command-char skeleton-pair-alist)
- (assq last-command-char '((?( _ ?))
- (?[ _ ?])
- (?{ _ ?})
- (?< _ ?>)
- (?` _ ?')))
- `(,last-command-char _ ,last-command-char)))
- (if mark -1))))))
-
-
- ;; A more serious example can be found in sh-script.el
- ;;; (defun mirror-mode ()
- ;; "This major mode is an amusing little example of paired insertion.
- ;;All printable characters do a paired self insert, while the other commands
- ;;work normally."
- ;; (interactive)
- ;; (kill-all-local-variables)
- ;; (make-local-variable 'skeleton-pair)
- ;; (make-local-variable 'skeleton-pair-on-word)
- ;; (make-local-variable 'skeleton-pair-filter)
- ;; (make-local-variable 'skeleton-pair-alist)
- ;; (setq major-mode 'mirror-mode
- ;; mode-name "Mirror"
- ;; skeleton-pair-on-word t
- ;; ;; in the middle column insert one or none if odd window-width
- ;; skeleton-pair-filter (lambda ()
- ;; (if (>= (current-column)
- ;; (/ (window-width) 2))
- ;; ;; insert both on next line
- ;; (next-line 1)
- ;; ;; insert one or both?
- ;; (= (* 2 (1+ (current-column)))
- ;; (window-width))))
- ;; ;; mirror these the other way round as well
- ;; skeleton-pair-alist '((?) _ ?()
- ;; (?] _ ?[)
- ;; (?} _ ?{)
- ;; (?> _ ?<)
- ;; (?/ _ ?\\)
- ;; (?\\ _ ?/)
- ;; (?` ?` _ "''")
- ;; (?' ?' _ "``"))
- ;; ;; in this mode we exceptionally ignore the user, else it's no fun
- ;; skeleton-pair t)
- ;; (let ((map (make-vector 256 'skeleton-pair-insert-maybe))
- ;; (i 0))
- ;; (use-local-map `(keymap ,map))
- ;; (while (< i ? )
- ;; (aset map i nil)
- ;; (aset map (+ i 128) nil)
- ;; (setq i (1+ i))))
- ;; (run-hooks 'mirror-mode-hook))
-
- (provide 'skeleton)
-
- ;; skeleton.el ends here
-